perm filename BRAKE.1[MAC,LSP] blob sn#210795 filedate 1976-04-10 generic text, type T, neo UTF8
(DECLARE (*FEXPR IOG BRAKE UNBRAKE)
	   (SPECIAL %#A %#CE W))


(DEFUN BRAKE FEXPR (FORM) 
       (PROG (FUNAME NUMBER PATTERN CONDITION POSITION BREAK) 
	     (SETQ FORM (CONS NIL FORM))
	     (COND ((NULL (SETQ FUNAME (GET FORM 'IN)))
		    (SETQ FUNAME (%GETNAME %#A)))
		   (T (APPLY '%DATA-INIT (LIST FUNAME))))
	     (SETQ NUMBER (OR (GET FORM 'NUMBER) 1.) 
		   CONDITION (OR (GET FORM 'IF) T) 
		   POSITION (CAR (OR (MEMBER 'AFTER FORM)
				     (MEMBER 'BEFORE FORM))) 
		   PATTERN (OR (GET FORM POSITION)
			       (RETURN 'WHERE??)))
	     (%EVALUATE 'TOP)
	     (SETQ BREAK (LIST 'BREAK
			       (LIST 'IN
				     FUNAME
				     POSITION
				     PATTERN
				     'NUMBER
				     NUMBER)
			       CONDITION))
	     (RETURN (COND ((NULL (%EVALUATE (LIST 'F
						   PATTERN
						   NUMBER)))
			    'WHERE??)
			   (T (%EVALUATE (LIST 'CR
					       (COND ((EQUAL POSITION
							     'AFTER)
						      (LIST 'PROG2
							    NIL
							    %#CE
							    BREAK))
						     ((LIST 'PROG2
							    BREAK
							    %#CE)))))
			      (IOG W
				   (SETQ ↑W T)
				   (%EVALUATE 'OK))
			      (%EVALUATE 'TOP)
			      (LIST FUNAME 'BROKEN)))))) 

(DEFUN UNBRAKE FEXPR (FORM) 
       (PROG (?FORM) 
	     (COND (FORM (APPLY '%DATA-INIT FORM)))
	     (%EVALUATE 'TOP)
	     (RETURN (DO NIL
			 ((NULL (%EVALUATE '(F (BREAK (IN ?
							  ?
							  ?
							  NUMBER
							  ?)
						      ?))))
			  (%EVALUATE 'TOP)
			  (IOG W (SETQ ↑W T) (%EVALUATE 'OK))
			  (LIST (%GETNAME %#A) 'UNBROKEN))
			 (%EVALUATE '↑)
			 (AND (OR (%MATCH '(PROG2 (BREAK ? ?) ?FORM)
					  %#CE)
				  (%MATCH '(PROG2 NIL
						  ?FORM
						  (BREAK ? ?))
					  %#CE))
			      (%EVALUATE '(PR ?FORM)))))))